perm filename PPSAV.FAI[HAK,HPM] blob
sn#173096 filedate 1976-07-08 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00007 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 TITLE PPSAV
C00003 00003 BEG: TDZA A,A START HERE
C00006 00004 REEGO: SETZM CRTERM#
C00007 00005 TAB: PUSHJ P,WRCH
C00009 00006 RCHNW: MOVE C,[700,,WRD-1]
C00011 00007 FILE NAME SCANNER. ERROR ROUTINES.
C00016 ENDMK
C⊗;
TITLE PPSAV
; Modified to accept filename AJT March 1975
;Modified to use low core pointers instead of EDDT syms--ME August 1975
A←1
B←2
C←3
D←4
E←5
T←15
TT←16
P←17
LPDL←←69
DEFINE SYMS{FOR X IN(JBTLIN,LETAB,PPCALL,TPJMP,TBLKPT)}
EXTERN JOBREL,JOBFF
LOC 124
REE
RELOC 0
BEG: TDZA A,A ;START HERE
REE: MOVNI A,1
MOVEM A,REESW#
MOVE P,[-LPDL,,PDL]
RESET
MOVSI A,1777
SETPR2 A,
JRST BEG0
SKIPN A,400321
JRST BEG0 ;This system version doesn't have my pointers.
HLRZM A,TBLKPT
HRRZM A,TPJMP
MOVE A,400322
HRRZM A,PPCALL
MOVE A,400236
MOVEM A,JBTLIN
MOVE A,400237
MOVEM A,LETAB
JRST BEG0A ;OK, got values from low core words.
BEG0: PUSHJ P,LOOK
JRST SYMERR
BEG0A: PUSHJ P,FSCAN ;LOOK FOR A FILENAME
MOVE A,[FILE,,ENTR]
BLT A,ENTR+3
OPEN [0↔'DSK '↔OBUF,,IBUF]
JRST 4,.
ENTER ENTR
JRST ENTFAI
MOVSI A,376000
SETPR2 A,
JRST 4,.
SKIPE REESW#
JRST REEGO
BEG1: PJOB A,
ADD A,JBTLIN
HRRE A,400000(A)
JUMPL A,[EXIT] ;DETACHED
BEG2: CAIL A,20
CAIL A,120
JRST [OUTSTR[ASCIZ/DPYS ONLY
/]
EXIT]
ADD A,LETAB
HRRZ A,400000-20(A)
JUMPE A,[OUTSTR[ASCIZ/NOT IN USE
/]
EXIT]
HRLZ T,400037
TLZN T,400000
JRST BEG3
HRRI T,400000
SETPR2 T,
JRST 4,.
BEG3: TRC T,400000
HRRM T,APNT
SUBI T,2
HRLI T,-20
MOVSM T,JMPOFF#
ADD A,PPCALL
HLRZ A,@APNT
MOVEI B,1(A)
ADD B,TPJMP
HRLM B,ENDTST
ADD A,TBLKPT
HRRZ A,@APNT
ADD A,APNT
HRLI A,444400
MOVEM A,WRDP#
SETZM CCNT#
MOVNI A,69
MOVEM A,BLKCNT#
JRST LF1
MAIN: PUSHJ P,RCH
JRST DONE
MAINR: CAIN C,11
JRST TAB
CAIN C,12
JRST LF
CAIE C,13
CAIN C,14
JRST QUOTIT
MAINW: PUSHJ P,WRCH
JRST MAIN
REEGO: SETZM CRTERM#
OUTSTR [ASCIZ/LINE?/]
MOVEI A,0
REELUP: INCHWL C
CAIN C,175
JRST BEG2
CAIN C,15
JRST GOTCR
LSH A,3
ADDI A,-"0"(C)
JRST REELUP
GOTCR: INCHRW T
SETOM CRTERM
JRST BEG2
TAB: PUSHJ P,WRCH
MOVEI A,
TABL: PUSHJ P,RCH
JRST TABX
CAIN C,40
AOJA A,TABL
CAIN C,11
JRST MAIN
PUSHJ P,OOPS
JRST MAINR
TABX: PUSHJ P,OOPS
JRST DONE
LF: PUSHJ P,WRCH
LF1: PUSHJ P,RCH
JRST DONE
CAIE C,40
JRST MAINR
PUSHJ P,RCH
JRST LF2
CAIN C,15
JRST MAINR
PUSH P,C
MOVEI C,40
PUSHJ P,WRCH
POP P,C
JRST MAINR
LF2: MOVEI C,40
PUSHJ P,WRCH
DONE: CLOSE
SKIPE REESW
SKIPE CRTERM
EXIT
SETZM ENTR+3
LOOKUP ENTR
JRST [OUTSTR [ASCIZ /FILE WENT AWAY?
/]
CALLI 12]
TLUP: SOSG IBUF+2
IN
JRST .+2
EXIT
ILDB T,IBUF+1
OUTCHR T
JRST TLUP
QUOTIT: PUSH P,C
MOVEI C,177
PUSHJ P,WRCH
POP P,C
JRST MAINW
RCHNW: MOVE C,[700,,WRD-1]
MOVEM C,CHRP#
MOVEI C,5
MOVEM C,CCNT
RCHNW2: ILDB C,WRDP
TRNN C,1
JRST RCHNB
MOVEM C,WRD
RCH: SOSGE CCNT
JRST RCHNW
ILDB C,CHRP
JUMPE C,RCH
AOS (P)
CPOPJ: POPJ P,
RCHNB: CAMN C,ENDTST
POPJ P,
ADD C,JMPOFF
TRNN C,-1
AOSLE BLKCNT
JRST UNEX
HLRM C,WRDP
JRST RCHNW2
WRCH: SOSG OBUF+2
OUTPUT
IDPB C,OBUF+1
POPJ P,
OOPS: JUMPE A,CPOPJ
PUSH P,C
MOVEI C,40
PUSHJ P,WRCH
SOJG A,.-1
POP P,C
POPJ P,
UNEX: OUTSTR[ASCIZ/UNEXPECTED END
/]
JRST DONE
APNT: (A)
WRD: 0↔-1
ENDTST: 20
IBUF: BLOCK 3
OBUF: BLOCK 3
ENTR: BLOCK 4
FILE: BLOCK 4
PDL: BLOCK LPDL
;FILE NAME SCANNER. ERROR ROUTINES.
FSCAN: RESCAN ;RESCAN TO LOOK FOR A FILE NAME.
L1: INCHWL A ;FLUSH TO THE SEMICOLON
CAIN A,12 ;OR TO LF
JRST DEFNAM ;USE DEFAULT NAME - NO SEMI SEEN
CAIE A,";" ;SEMI-COLON YET?
JRST L1 ;NO, CONTINUE SCANNING
FILNAM: SETZM FILE
MOVE A,[FILE,,FILE+1]
BLT A,FILE+3
PUSHJ P,GETSIX ;GET THE FILE NAME
JUMPE B,DEFNAM ;IF NO NAME SEEN, USE THE DEFAULT
MOVEM B,FILE
CAIE A,"."
JRST FSP
PUSHJ P,GETSIX
HLLZM B,FILE+1
FSP: CAIE A,"["
JRST FSCR
PUSHJ P,GETSIX
CAIE A,","
JRST FERR
PUSHJ P,RADJ
HLLZM B,FILE+3
PUSHJ P,GETSIX
PUSHJ P,RADJ
HLRM B,FILE+3
MOVEI B,0
CAIN A,"]"
PUSHJ P,GETSIX
JUMPN B,FERR
FSCR: CAIE A,12
JRST FERR
POPJ P,
DEFNAM: MOVE A,['PPSAV '] ;RETURN DEFAULT NAME.
MOVEM A,FILE
MOVSI A,'TMP'
MOVEM A,FILE+1
SETZM FILE+2
SETZM FILE+3
POPJ P,
GETSIX: MOVEI B,0
MOVE C,[POINT 6,B]
GETSX1: INCHWL A
CAIE A,40
CAIN A,15
JRST GETSX1
CAIL A,"A"+40
CAILE A,"Z"+40
JRST .+2
JRST GETSX3
CAIL A,"A"
CAILE A,"Z"
JRST .+2
JRST GETSX2
CAIL A,"0"
CAILE A,"9"
POPJ P, ;DELIMITER IS ANY NON-SIXBIT CHARACTER
GETSX2: SUBI A," "
GETSX3: TLNE C,770000
IDPB A,C
JRST GETSX1
RADJ: JUMPE B,FERR1
TRNE B,-1
JRST FERR1
TLNE B,77
POPJ P,
LSH B,-6
JRST .-3
FERR1: POP P,(P)
FERR: CLRBFI
OUTSTR [ASCIZ/
Illegal file name. Try again: /]
JRST FILNAM
SYMERR: OUTSTR[ASCIZ/CAN'T GET SYMS
/]
EXIT
ENTFAI: OUTSTR [ASCIZ/ENTER FAILED
/]
EXIT
LKEND←←BEG
.INSERT LOOK[FW,REG]